home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbs_mpl.zip / MBS30705.MRG < prev    next >
Text File  |  1992-07-05  |  83KB  |  2,239 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB3.BAS to produce E:\RBBS\CHAT\RBBSSUB3.BAS
  3. * E:\RBBS\STOCK\RBBSSUB3.BAS:  Date 6-20-1992  Size 129071 bytes
  4. * ------------[ Created 07-05-1992 07:15:49 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB3.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB3.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  AllCaps         58050 Convert a string to all upper case characters
  23. '  AMorPM          41498 Calculate the current time as AM or PM
  24. '  AskGraphics     43004 Determine users graphic default
  25. * ------[ first line different ]------
  26. '  BadFile         20841 Check for system crash attempt with bad device name 'Pe 09/11/91
  27. '  Carrier         42000 Test for whether to continue in RBBS
  28. '  CheckTime       58070 Test to insure that users don't exceed their time
  29. '  CheckCarrier    42005 Checks whether still have carrier
  30. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  31. '  CheckTimeRemain 41007 Set up to log off if time exceeded  'Lk 10/24/91
  32. '  CommInfo        44020 Get users baud rate and parity in a string format
  33. '  CountLines      58160 Count categories a file can be classified into
  34. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  35. '  DelayTime       50495 Wait number of seconds specified before returning
  36. '  DispCall        57001 Display callers file
  37. '  DispTimeRemain  41032 Compute and display time remaining
  38. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  39. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  40. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  41. '  FindLast        58600 Finds last occurence of a string in a string
  42. '  FlushKeys       35000  Completely flush all user input
  43. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  44. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  45. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  46. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  47. '  InitIBM         30000 Open/create NetBIOS semaphore file
  48. '  AddCommas       58130 Format commands in the command prompt
  49. '  Library         21105 Provide support for "library" drives
  50. '  LinesInFile     58161 Counts lines in a file
  51. '  LoadNew         58140 Find the latest uploads
  52. '  ModemPut        52070 Write a modem command string to the modem
  53. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  54. '  OpenMsg         30500 Open the messages file as file number 1
  55. '  PageUp          33202 Display user info. on local screen for ZSysop
  56. '  ReadProf        44000 Read user's profile on return from a "door"
  57. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  58. '  SetOpts         58100 Set correct prompt line for each subsystem
  59. '  SortString      58120 Sort characters in a string
  60. '  TimeRemain      41010 Compute time remaining in minutes
  61. '  UpdtUpload      20705 Updates upload directory file
  62. '  WildFile        20290 Determines whether string matches a pattern
  63. '  XferType        21600 Identify the file transfer protocol
  64. '
  65. '  $INCLUDE: 'RBBS-VAR.BAS'
  66. '
  67. * REPLACING old line(s) by new
  68. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  69. ' $PAGE
  70. '  NAME    -- WildFile
  71. '
  72. '  INPUTS  -- PARAMETER             MEANING
  73. '             Pattern$           PATTERN TO CHECK AGAINST
  74. '             ItemToMatch$       FILE NAME TO MATCH
  75. '
  76. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  77. '
  78. '  PURPOSE  Determine whether a file name is an instance of
  79. '    a file specification.  Exactly like DOS except that ? must have a
  80. '    character.
  81. '
  82.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  83.       IF Pattern$ <> PrevPattern$ THEN _
  84.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  85.          PrevPattern$ = Pattern$
  86.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  87.       DoesMatch = ZFalse
  88.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  89.          EXIT SUB
  90.       CALL WildCard (PPrefix$,IPrefix$)
  91.       IF NOT ZOK THEN _
  92.          EXIT SUB
  93.       CALL WildCard (PExt$,IExt$)
  94.       DoesMatch = ZOK
  95.       END SUB
  96. * ------[ first line different ]------
  97. '
  98. ' Pe 02/03/90---- Removed SendName and Testuser subs
  99. '
  100. '
  101.  
  102. ' ********* Maple UPDTU... ******
  103. '
  104. '
  105. * DELETING old line(s)
  106. 20293
  107. 20295
  108. 20296
  109. 20298
  110. 20300
  111. 20305
  112. 20306
  113. 20310
  114. 20313
  115. 20315
  116. * REPLACING old line(s) by new
  117. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  118. ' $PAGE
  119. * ------[ first line different ]------
  120. '  SUBROUTINE NAME    -- UpdtUpload
  121. '
  122. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  123. '                        ZFileName$
  124. '                        ZUpldDir$
  125. '                        ZFileNameHold$
  126. '                        ZShareIt
  127. '                        ZFMSDirectory$
  128. '                        ZWasQ!
  129. '                        TCA!
  130. '
  131. '  OUTPut PARAMETERS  -- ZBytesInFile#
  132. '                        ZSecsPerSession!
  133. '
  134. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  135. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  136. '
  137.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1),LinesInDesc,WasFF) STATIC '<===
  138.       ON WasFF GOTO 20710,20724,20722   'Pe 11/20/89
  139. * DELETING old line(s)
  140. 20708
  141. 20709
  142. * REPLACING old line(s) by new
  143. * ------[ first line different ]------
  144. 20710 ZAlreadyGiven = ZFalse         'Pe BatchUp Mod
  145.       ZAbort = ZFalse    ' PE ZAbort MOD
  146.       Call QuickTput1 ("Describe " + ZFileNameHold$ +ZCrLf$ + _
  147.      "( Begin with /  if for SysOp only) or enter Abort to cancel)" +ZCrLF$ + _
  148.        (LEFT$("|-----<Min----+---2+0---+---3+0---+---4+0---+-",_
  149.       ZMaxDescLen - 4) + "Max>"))    'JW03-20-92
  150.       ZOutTxt$ = ""
  151.       ZSubParm = 1
  152.       ZParseOff = ZTrue
  153.       CALL TGet
  154.       CALL Carrier
  155.       IF ZSubParm = -1 THEN _                'Pe 11/20/89
  156.          EXIT SUB                            'Pe 11/20/89
  157.       TempUserIn$ = ZUserIn$                 'Pe 02/17/90
  158.       CALL AllCaps (TempUserIn$)             'Pe 02/17/90
  159.       IF TempUserIn$ = "ABORT" THEN _        'Pe 02/17/90
  160.       ZAbort = ZTrue : _
  161.       TempUserIn$ = "" : _                    'Pe 02/17/90
  162.       EXIT SUB
  163.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 7 THEN _
  164. CALL QuickTput1(" Description must be 7 chars min," + STR$(ZMaxDescLen) +_
  165.       " chars max" +ZCrLF$ +" ENTER the word Abort to cancel transfer...") : _
  166.          GOTO 20710
  167. * REPLACING old line(s) by new
  168. * ------[ first line different ]------
  169. 20712 ZDesc$ = ZUserIn$
  170.       IF NOT ZLimitSearchToFMS THEN _
  171.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  172.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  173.              GOTO 20719_
  174.             ELSE GOTO 20716
  175. * REPLACING old line(s) by new
  176. * ------[ first line different ]------
  177. 20715  IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  178.          ZUCat$ = "***" : _
  179.          GOTO 20719
  180. * INSERTING new line(s)
  181. 20716 ZUCat$ = ZDefaultCatCode$
  182.       IF ZSubParm = -1 OR _
  183.       ZUserSecLevel < ZSLCategorizeUplds THEN _
  184.       GOTO 20719
  185.      If ZMplPersUpload = Ztrue Then _                      'Pe 06/08/91
  186.                Goto 20719
  187. * REPLACING old line(s) by new
  188. * ------[ first line different ]------
  189. 20717 TempIndex = ZLastIndex             'Pe 09/14/91
  190.       CALL BufFile (ZUpcatHelp$,WasX)
  191.       ZLastIndex = TempIndex             'Pe 09/14/91
  192. * REPLACING old line(s) by new
  193. * ------[ first line different ]------
  194. 20718 ZOutTxt$ = "Upload best fits what category "
  195.       ZSubParm = 1
  196.       CALL TGet
  197.       CALL AraAllCaps (ZUserIn$(),1)
  198.       IF ZSubParm = -1 THEN _
  199.        EXIT SUB                                   'Pe 11/20/89
  200.       IF ZWasQ = 0 THEN _
  201.          GOTO 20717
  202.       IF ZUserIn$(1) = "H" OR _
  203.          ZUserIn$(1) = "*" OR _
  204.          ZUserIn$(1) = "?" THEN _
  205.          GOTO 20717
  206.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  207.       IF Found > 0 THEN _
  208.          ZUCat$ = ZCategoryCode$(Found) : _
  209.          IF LEN(ZUCat$) > 0 AND LEN(ZUCat$) < 4 AND INSTR(ZUCat$,",") = 0 THEN _
  210.             GOTO 20719
  211.       ZUCat$ = ""
  212.       IF NOT ZLimitSearchToFMS THEN _
  213.          StrewTo$ = ZDirPath$ + _
  214.                      ZUserIn$(1) + _
  215.                      "." + _
  216.                      ZDirExtension$ : _
  217.    CALL FindIt (StrewTo$) : _                  'Pe 11/21/89
  218.     IF ZOK THEN _
  219.             GOTO 20719 _
  220.          ELSE CALL WORDInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  221.               IF ZOK THEN _
  222.                  GOTO 20719
  223.       StrewTo$ = ""
  224.       CALL QuickTPut1 ("No such category " + ZUserIn$(1))
  225.       GOTO 20717                                      'Pe 11/21/89
  226. * REPLACING old line(s) by new
  227. * ------[ first line different ]------
  228. 20719 IF ZUpBatchTransfer Then _
  229.       CALL BatchUpLoad (ZDesc$,ZUCat$,1) : _
  230.          Goto 20720
  231.           IF ZMplPersUpload = ZTrue THEN _
  232.            ZMplPersUpload = ZFalse : _
  233.           GOTO 20720
  234.         IF ZUserSecLevel >= ZAskExtendedDesc AND _
  235.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  236.          ZOutTxt$ = "Add an EXTENDED DESCRIPTION of " + _
  237.               ZFileNameHold$ + " (Y,[N])" : _
  238.          ZTurboKey = -ZTurboKeyUser : _
  239.          ZSubParm = 1 : _
  240.          CALL TGet : _
  241.      IF ZSubParm <> -1 THEN _
  242.         IF  ZYes THEN _
  243.        CALL SkipLine (2):_
  244.       CALL QuickTPut1 (Chr$(7)+" Description will be Entered AFTER the UPLOAD is Completed"+ZCrLF$) : _
  245.     CALL DelayTime (2) :_
  246.    ZGetExtDesc = ZTrue
  247.   '
  248. * REPLACING old line(s) by new
  249. * ------[ first line different ]------
  250. 20720 CALL OpenOutW ("UPDESC" +ZNodeID$ +".LST")
  251.           Print #2, ZFileName$
  252.           Print #2, ZFileNameHold$
  253.           Print #2, ZDesc$
  254.           Print #2, ZUCat$
  255.           Print #2, ZActiveFMSDir$
  256.           Print #2, ZFMSDirectory$
  257.           Print #2, ZAbort
  258.           Print #2, ZGetExtDesc
  259.           Print #2, StrewTo$
  260.           Print #2, ZAllwaysStrewTo$
  261.           Print #2, ZUpldDir$
  262.           Close 2
  263.   EXIT SUB
  264. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  265. '
  266. * REPLACING old line(s) by new
  267. * ------[ first line different ]------
  268. 20722 GOSUB 20760       'Pe 09/12/91
  269.       GOTO 20732        'Pe 09/12/91
  270. '
  271. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  272. '
  273. * DELETING old line(s)
  274. 20723
  275. * INSERTING new line(s)
  276.  20724 IF ZPrivateDoor THEN
  277.         CALL OpenWork (2,"UPDESC" +ZNodeID$ +".LST")
  278.          While Not EOF(2)
  279.           Input #2, ZFileName$
  280.           Input #2, ZFileNameHold$
  281.           Input #2, ZDesc$
  282.           Input #2, ZUCat$
  283.           Input #2, ZActiveFMSDir$
  284.           Input #2, ZFMSDirectory$
  285.           Input #2, ZAbort
  286.           Input #2, ZGetExtDesc
  287.           Input #2, StrewTo$
  288.           Input #2, ZAllwaysStrewTo$
  289.           InPut #2, ZUpldDir$
  290.          Wend
  291.         Close 2
  292.     END IF
  293.      CALL KillWork ("UPDESC" +ZNodeID$ +".LST")      'Pe 06/10/92
  294.          IF ZErrCode > 0 THEN _                      'Pe 06/10/92
  295.             ZErrCode = 0                             'Pe 06/10/92
  296.   GOSUB 20738        'find uploaded file
  297. '
  298. If Not ZAlreadyGiven THEN
  299.     CALL TimeRemain (MinsRemaining)
  300.       IF ZPrivateDoor THEN _
  301.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  302.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  303. END IF
  304. '
  305. '************************ New Convert code begins here *******************
  306. ' added X2ZIP?.LST.......01/18/90
  307. '
  308. '      Zip Convert code.  Does the following:
  309. '     IF X2ZIP? (?=Node #) is found then any file extension
  310. '     Listed in this file is NOT touched any other file will
  311. '     Be converted to ZIP format. IF the file is NOT found then
  312. '     user is asked to convert file....!! 
  313. '     The First line determins weather to ask user to Convert or not
  314. '     This should either be a Yes or NO (in Upper case only) if Yes
  315. '     then  user has the option of converting the file the rest of the
  316. '     file should have one EXTENSION  per line including the "."
  317. '    ex: .ARC <CR> 
  318. '
  319. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  320. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  321. '         ZOO.BAT
  322. '
  323. '      The Library work path (Config parm # 304) is used for a work area !!!
  324. '
  325.   IF ZAbort = ZTrue THEN _     'Corrects aborted uploads
  326.     EXIT SUB                'corrects aborted uploads
  327.      CALL BreakFileName (ZFileName$, WDR$, WZZ$, WX$, ZTrue)    'Pe 11/26/89
  328.       Ext$ = WX$
  329. '
  330. ' Pe 09/25/91 to next comment
  331. '
  332. CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  333.   WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
  334.    CALL FindIt (WasX$)
  335.     IF ZOK THEN 
  336.      CALL QuickTPut1 ("Testing upload...")
  337.       CALL ReadDir (2,1)
  338.        ZGSRAra$(2) = ZNodeWorkDrvPath$ + "VCHK" + ZNodeFileID$
  339.          IF EOF(2) THEN _
  340.            WasX$ = ZOutTxt$ : _
  341.            ZGSRAra$(1) = ZFileName$ _
  342.           ELSE WasX$ = WasX$ + " " + _
  343.                ZFileName$ + " " + ZGSRAra$(2)
  344.            CALL ShellExit (WasX$)
  345.          CALL FindIt (ZGSRAra$(2))
  346.        IF ZOK THEN _
  347.          IF LOF(2) > 2 THEN _
  348.             ZBytesInFile# = 0.0 : _
  349.              WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
  350.               CALL QuickTPut1 (WasX$) : _
  351.              CALL UpdtCalr (WasX$,2) : _
  352.             CALL KillWork (ZFileName$) : _
  353.            EXIT SUB
  354.          GOTO 20727
  355. End if
  356.        WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT"
  357.         CALL FindIt (WasX$)
  358.          IF NOT ZOK THEN _
  359.           GOTO 20727
  360. '
  361.      TooZip$ = ZDirPath$+"X2ZIP" + ZNodeID$ + ".LST"   'Pe 06/01/92
  362.    CALL FindIt (TooZip$)
  363.   IF NOT ZOK THEN _    'Pe 06/01/92
  364.     GOTO 20726
  365.       CALL OpenWork (2,TooZip$)
  366.        WHILE NOT EOF(2)
  367.          INPUT #2, Check$
  368.            IF Check$ = "Yes" or Check$ = "YES" THEN _
  369.              AskToConvert = Ztrue :_
  370.             CLOSE 2 : _
  371.            GOTO 20725
  372.           IF WX$ = Check$ THEN _ 
  373.          CLOSE 2: _
  374.         GOTO 20727
  375.        WEND
  376.      CLOSE 2 
  377. '
  378. 20725 IF ZAutoEnd = 1 THEN                                        'Pe 01/24/90
  379.        IF WX$ = Check$ THEN GOTO 20727 Else GOTO 20726            'Pe 01/24/90
  380.       END IF
  381. IF ZSysop OR ZUserSecLevel > = ZAddDirSecurity OR AskToConvert = ZTrue THEN 
  382. AskToConvert = ZFalse
  383.  ZSubParm = 1
  384.   ZOutTxt$ = "Convert or verify " + ZFileName$ + " ([Y],N) "
  385.    ZTurboKey = -ZTurboKeyUser
  386.      CALL TGet 
  387.       IF ZSubParm = -1 THEN _
  388.         EXIT SUB
  389.          IF ZNO THEN _
  390.         GOTO 20727
  391.      END IF
  392. * REPLACING old line(s) by new
  393. * ------[ first line different ]------
  394. 20726  ZOutTxt$ = "Converting"         'Pe 01/26/92
  395.      IF Ext$ = ZDefaultExtension$ THEN _
  396.     ZOutTxt$ = "Re-" + ZOutTxt$
  397.   CALL QuickTPut1 (ZOutTxt$ + " upload to "+ZDefaultExtension$+".  Please wait...")
  398. CALL OpenWork (2,WasX$)      'Pe 09/25/91
  399.      CALL ReadDir (2,1)
  400.       IF EOF(2) THEN _
  401.          WasX$ = ZOutTxt$
  402.       ZGSRAra$(1) = ZFileName$
  403.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  404.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  405.       ZUserIn$(0) = ZFileName$
  406.       ZFileName$ = Pre$ + ZFileNameHold$
  407.       CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$ + " " + Pre$) 'lk 06/03/91
  408.       CALL FindIt (ZFileName$)
  409.       IF NOT ZOK THEN _
  410.       CALL UpdtCalr (ZFileName$ + " < ABORTED in Cnvt >",2) : _
  411.          ZFileName$ = ZGSRAra$(1) : _
  412.          CALL FindIt (ZFileName$) : _
  413.          ZFileNameHold$ = Body$ + Ext$ : _
  414.          IF ZOK THEN _
  415.            ZFileName$ = ZFileNameHold$
  416. '
  417. ' ***  adds BBS name , users name and description to Zip comment if succesfull
  418. '
  419. * REPLACING old line(s) by new
  420. * ------[ first line different ]------
  421. 20727 GOSUB 20738     'Pe 11/21/89 calls findit if ok add bytes and upload#
  422. '
  423. 'Pe 01/26/92  Changes to add Zip Comments via a BAT file
  424. '             ext$ = Extension of file to add comment  eg ARJCMT.BAT for Arj's
  425. '             ZIPCMT.BAT for Zips
  426. '             format of the ZIPCMT.BAT file is as follows
  427. '             PKZIP -z [1] < [2]
  428. '
  429. '             can also use %1 %2  were %1 = Drive/path/filename
  430. '                                      %2 = Drive/Path/CommentFileName 
  431. '                                      %3 = Commport ( don't ask Why) 
  432. '
  433. '    Here is a BAT file that will add an advertisment + the Comment
  434. '   created by Maple RBBS to the Zip header ( WHY ??)
  435. '
  436. '    @Echo off
  437. '    Copy c:\Upload\MyAd.txt+c:\upload\upload.cmt c:\upload\upload1.cmt
  438. '    copy c:\upload\upload1.cmt c:\upload\upload.cmt
  439. '    del c:\upload\upload1.cmt
  440. '    PKZIP -z %1 < %2
  441. '
  442.     IF ZBytesInFile# > 2.0 THEN
  443.      WasX$ = ZDiskForDos$+Mid$(Ext$,2,3)+"CMT.BAT"
  444.       CALL FindIt (WasX$)
  445.         IF ZOK THEN
  446.           CLOSE 2
  447.           CALL QuickTPut1 ("Adding Your Name and File Description to "+ _
  448.                             ZFileNameHold$ + " ..." + ZCrLF$)
  449.            CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT
  450.           ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
  451.          ADDCMT2$ = ZCrLf$ +"Description: " + ZDesc$
  452.         ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + ZCrLf$
  453.        CALL OpenOutW (CommentName$)
  454.       PRINT #2, ADDCOMMENT$
  455.      CLOSE 2
  456.  
  457.           ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  458.            CALL OpenWork (2,WasX$)
  459.            CALL ReadDir (2,1)
  460.                 IF EOF(2) THEN _
  461.                    ZWasZ$ = ZOutTxt$ : _
  462.                    ZGSRAra$(1) = ZFileName$ : _
  463.                    ZGSRAra$(2) = CommentName$ _
  464.                 ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  465.                               " " + CommentName$ + " " + ZGSRAra$(3)
  466.             CALL ShellExit (ZWasZ$)
  467.  
  468.          GOSUB 20738          ' Adjust Bytes in file make sure we got it
  469.      END IF
  470.    END IF
  471.   ZOK = 0
  472.    CALL CheckNovell (ZOK)
  473.     IF ZOK <> -1 THEN _
  474.       CALL SetSharedAttr (ZFileName$, ZOK) : _
  475.        IF ZOK <> 0 THEN _
  476.         CALL PScrn ("Error setting shared attribute")
  477.       IF ZGetExtDesc THEN _
  478.         EXIT SUB 
  479. GOSUB 20760                   'Pe 09/12/91
  480.  
  481. * DELETING old line(s)
  482. 20728
  483. 20729
  484. 20731
  485. * REPLACING old line(s) by new
  486. * ------[ first line different ]------
  487. 20732 If ZMusic = ZFalse Then                                       'Pe 03/13/92
  488.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" OR NumPersonals > 0 THEN _
  489.       WX$ = WX$+"*"    'Pe 01/25/92
  490.       CALL AMorPM                                                  'Pe 11/25/89
  491.    IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN _  'Pe 11/25/89
  492.            ULBYNAME$ = "Sysop" _                                   'Pe 06/05/91
  493.          ELSE ULBYNAME$ = ZActiveUserName$                         'Pe 11/25/89
  494.       ULXXX$ = WZZ$+WX$+SPACE$(13-(LEN(WZZ$)+LEN(WX$)))            'Pe 01/24/90
  495.       UPLOADLG$ = "{C1"+ ULXXX$ + _                                'Pe 01/24/90
  496.                   "{C2"+ ULBYNAME$+SPACE$(34-LEN(ULBYNAME$)) + _   'Pe 01/24/90
  497.                   "{C3"+ DATE$ + "   " + _                         'Pe 01/24/90
  498.                   "{C4"+ ZTime$+" {C0"                             'Pe 01/24/90
  499.          CALL OpenWorkA (ZDirPath$ +"UPLOADLG.DEF")                'Pe 03/13/92
  500.          CALL PrintWorkA (UPLOADLG$)                               'Pe 11/25/89
  501.          CLOSE 2                                                   'Pe 01/18/90
  502. End IF                                                             'Pe 03/13/92
  503.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _ 
  504.         IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  505.          CALL UpdtCalr (ZUserIn$,2): _
  506.        GOTO 20733
  507. IF NumPersonals <> 0 THEN _ 
  508.          GOTO 20733            
  509.       IF ZPrivateDoor THEN _   
  510.          ZWasEN$ = ZUpldDoor$ _
  511.       ELSE ZWasEN$ = ZUpldDir$ 
  512.       GOSUB 20734 
  513. * INSERTING new line(s)
  514. 20733 ZWasDF$ = " >> uploaded << "
  515.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  516.       ZWasZ$ = WasX$ + _
  517.            Extension$ + _
  518.            ZWasDF$ + _
  519.            " at " + _
  520.            ZTime$ + _
  521.            " using " + _
  522.            ZWasFT$ + _
  523.            STR$(ZBytesInFile#)
  524.       CALL UpdtCalr (ZWasZ$,2)
  525.       ZUplds = ZUplds + 1
  526.       ZGlobalUplds = ZGlobalUplds + 1
  527.       ZULBytes! = ZULBytes! + ZBytesInFile#
  528.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  529. '
  530. IF NOT ZAlreadyGiven THEN
  531.       CALL TimeRemain (MinsRemaining!)
  532.       MinsToAdd = WasX! / 60
  533.       CALL ChkAddedTime (MinsToAdd)
  534.       WasX! = MinsToAdd * 60!
  535.       ZTimeCredits! = ZTimeCredits! + WasX!
  536.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  537.       IF ZPrivateDoor THEN _
  538.          WasX! = (WasX! - ZWasQ!) / 60.0 _
  539.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  540.       WasX$ = STR$(FIX(WasX!*10.0))
  541.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  542.         IF WasX! > 1.0 THEN _
  543.        CALL QuickTPut1 ("Session time increased by"+WasX$+" minutes")
  544. END IF
  545.       CALL QuickTPut ("Upload successful, Thanks for the file " + ZFirstName$ ,1)
  546.      CALL DelayTime (2)       'Pe 02/23/90
  547.     ZGetExtDesc = ZFalse
  548.   EXIT SUB
  549. * REPLACING old line(s) by new
  550. * ------[ first line different ]------
  551. 20734 '          ---[ lock file ]---
  552.       IF ZWasEN$ = "" THEN _
  553.          RETURN
  554.       FMSFormat = ZFalse
  555.       IF (ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS _
  556.           OR NumPersonals > 0 OR (ZPrivateDoor AND ZFMSDoor)) THEN _
  557.              FMSFormat = ZTrue _
  558.       ELSE CALL FindIt (ZWasEN$) : _
  559.            IF ZOK THEN _
  560.               CALL ReadDir (2,1) : _       'Pe 11/22/89
  561.               IF ZErrCode = 0 THEN _
  562.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  563.       IF NOT FMSFormat THEN _
  564.          ReadBackwards = ZFalse : _
  565.          FixedLen = 0 : _
  566.          ZUserIn$ = ZDesc$ : _
  567.          GOTO 20735                                  'Pe 06/08/91
  568.       FixedLen = 34 + ZMaxDescLen 
  569.       IF NumPersonals > 0 THEN _
  570.          WasX$ = "*" : _                                             ' Pe060891
  571.          MaxLen = ZPersonalLen _
  572.       ELSE MaxLen = 3 : _
  573.            WasX$ = ""                                                ' Pe060891
  574.       ZUCat$ = LEFT$(ZUCat$,MaxLen)
  575.       ZUCat$ = ZUCat$ + SPACE$(MaxLen - LEN(ZUCat$))
  576.       ZUserIn$ = ZDesc$ + _
  577.                  SPACE$(ZMaxDescLen - LEN(ZDesc$)) + _
  578.                  ZUCat$ + WasX$                                       ' Pe060891
  579.            ReadBackwards = ZTrue : _
  580.            CALL FindIt (ZWasEN$) : _
  581.            IF ZOK THEN _
  582.               CALL ReadDir (2,1) : _
  583.               IF ZErrCode = 0 THEN _
  584.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  585. * INSERTING new line(s)
  586. 20735 CALL LockAppend      
  587.       IF ZErrCode <> 0 THEN _
  588.          GOTO  20736
  589.  
  590. IF ZVoiceType <> 0 THEN                                        ' Pe 05/29/92
  591.       IF ReadBackwards and NumPersonals = 0 THEN _                  'PE 10/27/91
  592.      PRINT #2, using LEFT$("\                             " _  'BH042091
  593.                              + "                              " _  'BH042091
  594.                              + "                    ", _           'BH042091
  595.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  596.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  597.      '          ---[ append ]---
  598.       IF ZGetExtDesc THEN _
  599.          IF ReadBackwards THEN _
  600.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  601.                GOSUB 20737 : _
  602.             NEXT
  603.       PRINT #2,USING "\           \########  &  &"; _
  604.                      ZFileNameHold$; _
  605.                      ZBytesInFile#; _
  606.                      ZWasZ$; _
  607.                      ZUserIn$
  608.       IF ZGetExtDesc THEN _
  609.          IF NOT ReadBackwards THEN _
  610.             FOR WasI = 1 TO LinesInDesc : _
  611.                GOSUB 20737 : _
  612.             NEXT
  613.       IF NOT ReadBackwards and NumPersonals = 0 THEN _              ,Pe 10/27/91
  614.      PRINT #2, using LEFT$("\                             " _  'BH042091
  615.                              + "                              " _  'BH042091
  616.                              + "                    ", _           'BH042091
  617.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  618.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  619.        GOTO 20736
  620.    End IF                                                  'Pe 05/29/92
  621.  
  622.       IF ZGetExtDesc THEN _
  623.          IF ReadBackwards THEN _
  624.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  625.                GOSUB 20737 : _
  626.             NEXT
  627.       PRINT #2,USING "\           \########  &  &"; _
  628.                      ZFileNameHold$; _
  629.                      ZBytesInFile#; _
  630.                      ZWasZ$; _
  631.                      ZUserIn$
  632.       IF ZGetExtDesc THEN _
  633.          IF NOT ReadBackwards THEN _
  634.             FOR WasI = 1 TO LinesInDesc : _
  635.                GOSUB 20737 : _
  636.             NEXT
  637. * REPLACING old line(s) by new
  638. * ------[ first line different ]------
  639. 20736 CALL UnLockAppend      'Pe 06/08/91
  640.       FixedLen = 0
  641.       RETURN
  642. * INSERTING new line(s)
  643. 20737 WasX$ = ZOutTxt$(WasI)   'Pe 06/08/91
  644.       CALL Trim (WasX$)
  645.       IF WasX$ = "" THEN _
  646.          RETURN
  647.       IF NOT FMSFormat THEN _
  648.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  649.          RETURN
  650.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  651.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  652.       ELSE WasX$ = ""
  653.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  654.       RETURN
  655. 20738 CALL FindIt (ZFileName$)
  656. 20739 IF NOT ZOK THEN _                         'Pe 06/08/91
  657.          ZBytesInFile# = 0.0_
  658.       ELSE ZBytesInFile# = LOF(2)
  659.       IF ZBytesInFile# < 2.0 THEN _
  660.        ZAutoLogOffReq = ZFalse : _           'Pe 10/20/91     
  661.          EXIT SUB
  662.       RETURN
  663. * DELETING old line(s)
  664. 20741
  665. 20742
  666. * INSERTING new line(s)
  667. 20760 CALL FindItX (ZNodeWorkFile$,7)
  668.       ZUserIn$ = ZDesc$
  669.       WasX$ = DATE$
  670.       ZWasZ$ = LEFT$(WasX$,6) + _
  671.            RIGHT$(WasX$,2)
  672.       ZWasEN$ = ZPersonalDir$
  673.       NumPersonals = 0
  674.       IF NOT ZOK THEN _                                            'Pe 06/10/92
  675.          GOTO 20781                                                'Pe 06/10/92
  676.       UserFileIndexSave = ZUserFileIndex
  677.       UserRecordHold$ = ZUserRecord$
  678.       WHILE NOT EOF(7)
  679.          CALL ReadParmsX (7,ZWorkAra$(),2,1)
  680. IF LEFT$(ZWorkAra$(1),4) <> "ALL " AND _
  681.            ZWorkAra$(1) <> "ALL" AND VAL (ZWorkAra$(2)) > 0 THEN _ 'Pe 06/10/92
  682.             NumPersonals = NumPersonals + 1 : _
  683.             ZUCat$ = ZWorkAra$(1) : _
  684.             GOSUB 20734 : _ 
  685.             RcvrRecNum = VAL (ZWorkAra$(2)) : _
  686.             CALL SetUserFlag (RcvrRecNum,4096,"file")
  687.       WEND
  688.       CLOSE 7
  689.       IF NumPersonals > 0 THEN _
  690.          ZUserFileIndex = UserFileIndexSave : _
  691.          LSET ZUserRecord$ = UserRecordHold$
  692. 20781 ZUserIn$ = ZDesc$
  693.       WasX$ = DATE$
  694.       ZWasZ$ = LEFT$(WasX$,6) + _
  695.                RIGHT$(WasX$,2)
  696.       ZWasEN$ = StrewTo$
  697.       GOSUB 20734
  698.       ZWasEN$ = ZAllwaysStrewTo$
  699.       GOSUB 20734
  700.       RETURN
  701.       END SUB
  702. 20841 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'  'Pe 09/12/91
  703. ' $PAGE
  704. '
  705. '  NAME    -- BadFile
  706. '
  707. '  INPUTS  --     PARAMETER                    MEANING
  708. '               ZViolation$
  709. '               ZViolationsThisSession
  710. '               FilName$                      NAME OF FILE
  711. '
  712. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  713. '                                         2 = CHARACTER NOT ALLOWED
  714. '                                         3 = SYSTEM CRASH ATTEMPT
  715. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  716. '             FilName$                    Gets capitalized
  717. '
  718. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  719. '             to either crash the system or to breach RBBS-PC's security.
  720. '
  721.       SUB BadFile (FilName$,Result) STATIC
  722. '
  723. '
  724. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  725. '
  726. '
  727.       Result = 2
  728.       IF LEN(FilName$) < 1 THEN _
  729.          EXIT SUB
  730.       CALL BadFileChar (FilName$,ZOK)
  731.       IF NOT ZOK THEN _
  732.          EXIT SUB
  733.       CALL AllCaps (FilName$)
  734.       WasXX = INSTR(FilName$,".")
  735.       IF WasXX > 0 THEN _
  736.          IF WasXX < LEN(FilName$) THEN _
  737.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  738.             IF WasXX > 0 THEN _
  739.                EXIT SUB
  740.       WasXX = LEN(FilName$)
  741.       IF WasXX => 3 THEN _
  742.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  743.             GOTO 20842
  744.       IF WasXX => 4 THEN _
  745.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
  746.             GOTO 20842
  747.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  748.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  749.          EXIT SUB
  750.       WasXX = LEN(Body$)
  751.       IF WasXX => 3 THEN _
  752.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  753.             GOTO 20842
  754.       IF WasXX => 4 THEN _
  755.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
  756.             GOTO 20842
  757.       Result = 1
  758.       EXIT SUB
  759. 20842 ZViolationsThisSession = ZMaxViolations   'Pe 09/12/91
  760.       ZViolation$ = ZViolation$ + _
  761.                    FilName$
  762.       Result = 3
  763.       END SUB
  764. '
  765. * DELETING old line(s)
  766. 21105
  767. 21110
  768. 21115
  769. 21117
  770. 21120
  771. 21121
  772. 21122
  773. 21126
  774. 21130
  775. 21140
  776. 21145
  777. 21150
  778. 21151
  779. 21152
  780. 21153
  781. 21155
  782. 21156
  783. 21157
  784. 21158
  785. 21159
  786. * REPLACING old line(s) by new
  787. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  788. ' $PAGE
  789. '
  790. '  NAME    -- FileLock
  791. '
  792. '  INPUTS  --     PARAMETER                    MEANING
  793. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  794. '                                      2 FLUSH MESSAGE RECORD TO DISK
  795. '                                        AND UNLOCK MESSAGES
  796. '                                      3 LOCK MESSAGE FILE
  797. '                                      4 UNLOCK MESSAGE FILE
  798. '                                      5 LOCK USER FILE
  799. '                                      6 LOCK 4 RECORD BLOCK IN USER
  800. '                                        FILE
  801. '                                      7 UNLOCK USER FILE
  802. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  803. '                                        FILE
  804. '                                      9 LOCK UPLOAD DIRECTORY OR
  805. '                                        COMMENTS FILE
  806. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  807. '                                        COMMENTS FILE
  808. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  809. '               ZActiveUserFile$         NAME OF USER FILE
  810. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  811. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  812. '                                        FILE NAME TO LOCK/UNLOCK
  813. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  814. '
  815. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  816. '             ZBlk
  817. '             ZLockDrive
  818. '             ZLockFileName$
  819. '             ZLockStatus$
  820. '             ZMsgFileLock
  821. '             ZUserBlockLock
  822. '             ZUserFileLock
  823. '             ZUserFileIndex
  824. '
  825. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  826. '             multiple copies of RBBS-PC are sharing the same
  827. '             files in either a multi-tasking DOS environment or
  828. '             in a local area network environment
  829. '
  830.       SUB FileLock STATIC
  831. * ------[ first line different ]------
  832. If ZNetworkType = 0 THEN _                          'Pe 06/26/92
  833.     Exit Sub                                        'Pe 06/26/92
  834.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  835.                                     26500,27000,27500,29000,29500
  836.       EXIT SUB
  837. '
  838. '
  839. ' *  UNLOCK USERS AND MESSAGES
  840. '
  841. '
  842. * REPLACING old line(s) by new
  843. 22000 IF ZMsgFileLock = ZTrue THEN _
  844.          RETURN
  845.       ZMsgFileLock = ZTrue
  846.       MID$(ZLockStatus$,1,2) = "LM"
  847.       ZSubParm = 2
  848.       CALL Line25
  849.       ZLockFileName$ = ZActiveMessageFile$
  850.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  851.       RETURN
  852. '
  853. '
  854. * ------[ first line different ]------
  855. ' *  LOCK MESSAGE FILE (MULTI-LINK) removed in Maple code
  856. '
  857. '
  858. * REPLACING old line(s) by new
  859. * ------[ first line different ]------
  860. 22100   RETURN
  861. '
  862. '
  863. ' *  LOCK MESSAGE FILE (OMNINET)
  864. '
  865. '
  866. * REPLACING old line(s) by new
  867. 25000 IF NOT ZMsgFileLock THEN _
  868.          RETURN
  869.       ZMsgFileLock = ZFalse
  870.       MID$(ZLockStatus$,1,2) = "UM"
  871.       ZSubParm = 2
  872.       CALL Line25
  873.       ZLockFileName$ = ZActiveMessageFile$
  874.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  875.       RETURN
  876. '
  877. '
  878. * ------[ first line different ]------
  879. ' *  UNLOCK MESSAGE FILE (MULTI-LINK) removed in maple code
  880. '
  881. '
  882. * REPLACING old line(s) by new
  883. * ------[ first line different ]------
  884. 25100  RETURN
  885. '
  886. '
  887. ' *  UNLOCK MESSAGE FILE (OMNINET)
  888. '
  889. '
  890. * REPLACING old line(s) by new
  891. 26000 IF ZUserFileLock = ZTrue THEN _
  892.          RETURN
  893.       ZUserFileLock = ZTrue
  894.       MID$(ZLockStatus$,4,2) = "LU"
  895.       ZSubParm = 2
  896.       CALL Line25
  897.       ZLockFileName$ = ZActiveUserFile$
  898.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  899.       RETURN
  900. '
  901. '
  902. * ------[ first line different ]------
  903. ' *  LOCK USER FILE (MULTI-LINK) removed in maple code
  904. '
  905. '
  906. * REPLACING old line(s) by new
  907. * ------[ first line different ]------
  908. 26100  RETURN
  909. '
  910. '
  911. ' *  LOCK USER FILE (OMNINET)
  912. '
  913. '
  914. * REPLACING old line(s) by new
  915. 26500 IF ZUserBlockLock = ZTrue THEN _
  916.          RETURN
  917.       ZUserBlockLock = ZTrue
  918.       ZBlk = (ZUserFileIndex / 4) + .26
  919.       MID$(ZLockStatus$,7,2) = "LB"
  920.       ZSubParm = 2
  921.       CALL Line25
  922.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  923.       RETURN
  924. '
  925. '
  926. * ------[ first line different ]------
  927. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)  removed in maple code
  928. '
  929. '
  930. * REPLACING old line(s) by new
  931. * ------[ first line different ]------
  932. 26600  RETURN
  933. '
  934. '
  935. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  936. '
  937. '
  938. * REPLACING old line(s) by new
  939. 27000 IF NOT ZUserFileLock THEN _
  940.          RETURN
  941.       ZUserFileLock = ZFalse
  942.       MID$(ZLockStatus$,4,2) = "UU"
  943.       ZSubParm = 2
  944.       CALL Line25
  945.       ZLockFileName$ = ZActiveUserFile$
  946.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  947.       RETURN
  948. '
  949. '
  950. * ------[ first line different ]------
  951. ' *  UNLOCK USER FILE (MULTI-LINK) removed in maple code
  952. '
  953. '
  954. * REPLACING old line(s) by new
  955. * ------[ first line different ]------
  956. 27100  RETURN
  957. '
  958. '
  959. ' *  UNLOCK USER FILE (OMNINET)
  960. '
  961. '
  962. * REPLACING old line(s) by new
  963. 27500 IF NOT ZUserBlockLock THEN _
  964.          RETURN
  965.       ZUserBlockLock = ZFalse
  966.       ZBlk = (ZUserFileIndex / 4) + .26
  967.       MID$(ZLockStatus$,7,2) = "UB"
  968.       ZSubParm = 2
  969.       CALL Line25
  970.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  971.       RETURN
  972. '
  973. '
  974. * ------[ first line different ]------
  975. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) removed in maple code
  976. '
  977. '
  978. * REPLACING old line(s) by new
  979. * ------[ first line different ]------
  980. 27600  RETURN
  981. '
  982. '
  983. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  984. '
  985. '
  986. * REPLACING old line(s) by new
  987. 29010 RETURN
  988. '
  989. '
  990. * ------[ first line different ]------
  991. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS (MULTI-LINK) removed in mpl code
  992. '
  993. '
  994. * REPLACING old line(s) by new
  995. * ------[ first line different ]------
  996. 29100 RETURN
  997. '
  998. '
  999. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1000. '
  1001. '
  1002. * REPLACING old line(s) by new
  1003. 29510 RETURN
  1004. '
  1005. '
  1006. * ------[ first line different ]------
  1007. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS  (MULTI-LINK) remove in maple code
  1008. '
  1009. '
  1010. * REPLACING old line(s) by new
  1011. * ------[ first line different ]------
  1012. 29600  EXIT SUB
  1013. '
  1014. '
  1015. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1016. '
  1017. '
  1018. * REPLACING old line(s) by new
  1019. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1020. ' $PAGE
  1021. '
  1022. '  NAME    -- OpenMsg
  1023. '
  1024. '  INPUTS  --     PARAMETER                    MEANING
  1025. '              ZActiveMessageFile$
  1026. '              ZShareIt
  1027. '
  1028. '  OUTPUTS --  ZMsgRec$
  1029. '
  1030.       SUB OpenMsg STATIC
  1031. '
  1032. '
  1033. ' *  OPEN AND DEFINE MESSAGE FILE
  1034. '
  1035. '
  1036. * ------[ first line different ]------
  1037.      CLOSE 1
  1038.       IF ZShareIt THEN _
  1039.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1040.       ELSE OPEN "R",1,ZActiveMessageFile$
  1041.       FIELD 1,128 AS ZMsgRec$
  1042.       END SUB
  1043. * REPLACING old line(s) by new
  1044. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1045. ' $PAGE
  1046. '
  1047. '  NAME    -- FindFKey
  1048. '
  1049. '  INPUTS  --  PARAMETER                 MEANING
  1050. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1051. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1052. * ------[ first line different ]------
  1053. '             ZFullScreenEditor         USER'S PREFERENCE FOR ANSIed
  1054. '             ZCallersFile$             NAME OF CALLERS FILE
  1055. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1056. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1057. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1058. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1059. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1060. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1061. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1062. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1063. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1064. '             ZFirstName$               LOGGED ON USER'S First NAME
  1065. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1066. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1067. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1068. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1069. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1070. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1071. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1072. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1073. '             ZNodeID$                  NODE IDENTIFIER
  1074. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1075. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1076. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1077. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1078. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1079. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1080. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1081. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1082. '                                       -9  = GOT TO DOS
  1083. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1084. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1085. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1086. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1087. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1088. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1089. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1090. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1091. '
  1092. '  OUTPUTS --
  1093. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1094. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1095. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1096. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1097. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1098. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1099. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1100. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1101. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1102. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1103. '             ZSubParm                  -1 Carrier LOST
  1104. '                                       -2 CHAT MODE ACTIVATED
  1105. '                                       -3 FORCE CALLER ON-LINE
  1106. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1107. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1108. '                                       -6 TELL USER ACCESS IS DENIED
  1109. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1110. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1111. '
  1112. '  PURPOSE -- To determine if a function has been pressed on
  1113. '             the PC'S keyboard that is running RBBS-PC.
  1114. '
  1115.       SUB FindFKey STATIC
  1116.       LookUp = ZSubParm
  1117.       IF ZSubParm < -1 THEN _
  1118.          ZSubParm = 0 : _
  1119.          IF LookUp = - 8 THEN _
  1120.             GOTO 33070 _
  1121.          ELSE IF LookUp = - 9 THEN _
  1122.                  GOTO 31000 _
  1123.               ELSE IF LookUp = - 10 THEN _
  1124.                       GOTO 33090
  1125. '
  1126. '
  1127. ' *  TEST FOR FUNCTION KEY PRESSED
  1128. '
  1129. '
  1130. * REPLACING old line(s) by new
  1131. 31398 IF NOT ZLocalUser THEN _
  1132.          CALL Carrier : _
  1133.          IF ZSubParm = -1 THEN _
  1134.             GOTO 33970
  1135. * ------[ first line different ]------
  1136. '      IF INSTR("MUF",ZActiveMenu$) > 0 THEN 
  1137.       IF INSTR("|@",ZActiveMenu$) = 0 THEN _      'Pe\05\30\91
  1138.          GOTO 31399
  1139.       ZCursorLine = CSRLIN
  1140.       ZCursorRow = POS(0)
  1141.       LOCATE 25,1
  1142.       WasD$ = SPACE$(79)
  1143.       GOSUB 33210
  1144.       LOCATE 25,1
  1145.       WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1146.       GOSUB 33210
  1147.       CALL DelayTime (1)
  1148.       LOCATE ZCursorLine,ZCursorRow
  1149.       ZSubParm = 1
  1150.       CALL Line25
  1151.       GOTO 33970
  1152. * REPLACING old line(s) by new
  1153. 31399 IF ZFunctionKey = 22 THEN _
  1154.          CALL SkipLine (2) : _
  1155. * ------[ first line different ]------
  1156.          CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SysOp needs the system.") : _
  1157.          CALL DelayTime (8 + ZBPS) : _
  1158.          ZSubParm = -6 : _   'Pe 07/11/91
  1159.          GOTO 33970
  1160.       CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back")
  1161.       CALL DelayTime (8 + ZBPS) : _
  1162.       IF ZUserFileIndex < 1 THEN _
  1163.          ZSubParm = -6 : _                'Pe 07/11/91
  1164.          GOTO 33970
  1165.       ZUserSecLevel = ZMinLogonSec - 1
  1166.       CALL DenyAccess
  1167.       ZSubParm = -7                       'Pe 07/11/91
  1168.       GOTO 33970
  1169. '
  1170. '
  1171. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1172. '
  1173. '
  1174.  
  1175. * REPLACING old line(s) by new
  1176. 32000 IF NOT ZLocalUser THEN _
  1177.          CALL SkipLine (1) : _
  1178.          CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _
  1179.          ZFunctionKey = 0 : _
  1180.          CALL DelayTime (3)
  1181.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1182.       'SHELL ZDiskForDos$ + _
  1183.       '      "COMMAND"
  1184.       CLS
  1185.       IF NOT ZLocalUser THEN _
  1186.          CALL Carrier : _
  1187.          IF ZSubParm = -1 THEN _
  1188.             GOTO 33970
  1189.       ZSubParm = 2
  1190.       CALL Line25
  1191.       CALL QuickTPut1 ("Sysop back from DOS.  Returning control to you.")
  1192.       ZCommPortStack$ = ZCarriageReturn$
  1193. * ------[ first line different ]------
  1194.       ZWasCM = 0                                                     ' DD062901/ANSICHAT
  1195.       GOTO 33970
  1196. '
  1197. '
  1198. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1199. '
  1200. '
  1201. * REPLACING old line(s) by new
  1202. * ------[ first line different ]------
  1203. 33150 IF ZWasCM = ZTrue THEN _                                       ' DD070401/ANSICHAT
  1204.          GOTO 33970                                                  ' DD070401/ANSICHAT
  1205.       GOTO 33160
  1206. * REPLACING old line(s) by new
  1207. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1208.       ZPageStatus$ = ""
  1209.       CALL SkipLine (1)
  1210. * ------[ first line different ]------
  1211.       ZSysopGreeting$ = "Hi " + ZFirstName$ + ", this is " + _       ' DD062801/ANSICHAT
  1212.                         ZSysopFirstName$ + " " + ZSysopLastName$ + _ ' DD062801/ANSICHAT
  1213.                         ".  Sorry to break in and CHAT but..."       ' DD062801/ANSICHAT
  1214.  
  1215.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1216.       CALL TimeBack (1)
  1217.  
  1218.     IF ZANSITest = ZTrue OR ZWasGR > 1 THEN                        ' DD062801/ANSICHAT
  1219.          CALL ANSIChat                                               ' DD062801/ANSICHAT
  1220.       ELSE
  1221.          CALL SkipLine (1)
  1222.          CALL QuickTPut1 (ZSysopGreeting$)
  1223.          CALL SysopChat
  1224.       END IF
  1225. 'Sysop chat allows overstay of Scheduled Events- no way to control giveback
  1226.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1227.       CALL TimeBack (2)
  1228.       ZCommPortStack$ = CHR$(13)
  1229.       GOTO 33155
  1230. '
  1231. '
  1232. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1233. '
  1234. '
  1235. * REPLACING old line(s) by new
  1236. 33190 ZAdjustedSecurity = ZTrue
  1237.       ZUserSecSave = ZUserSecLevel
  1238.       IF (NOT ZConfMode) AND (NOT ZSubBoard) THEN _
  1239.          ZOrigSec = ZUserSecLevel
  1240.       ZSubParm = 2
  1241.       CALL Line25
  1242.       CALL SetPrompt
  1243.       GOTO 33970
  1244. '
  1245. * ------[ first line different ]------
  1246. '
  1247. ' * PGUP DISPLAY USER PROFILE
  1248. '
  1249. '
  1250. * REPLACING old line(s) by new
  1251. 33200 IF NOT ZLocalUser THEN _
  1252.          CALL Carrier : _
  1253.          IF ZSubParm = -1 THEN _
  1254.             GOTO 33970
  1255. * ------[ first line different ]------
  1256.       CALL PageUp
  1257.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1258.       GOSUB 33210
  1259.       WasD$ = "GRAPHICS: " + _
  1260.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1261.       GOSUB 33210
  1262.       WasD$ = "Protocol : " + _
  1263.            ZUserXferDefault$
  1264.       GOSUB 33210
  1265.       WasD$ = "UPPER CASE " + _
  1266.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1267.       GOSUB 33210
  1268.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1269.       GOSUB 33210
  1270.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1271.       GOSUB 33210
  1272.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1273.       GOSUB 33210
  1274.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1275.            " old BULLETINS on logon."
  1276.       GOSUB 33210
  1277.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1278.            " new files on logon."
  1279.       GOSUB 33210
  1280.       WasD$ = "AnsiEditor " + FNOffOn$(ZFullScreenEditor)
  1281.       GOSUB 33210
  1282.       ZTalkAll = ZFalse
  1283.       GOTO 33970
  1284. * REPLACING old line(s) by new
  1285. 33220 IF NOT ZLocalUser THEN _
  1286.          CALL Carrier : _
  1287.          IF ZSubParm = -1 THEN _
  1288.             GOTO 33970
  1289.       CLS
  1290. * ------[ first line different ]------
  1291.       ZWasCM = 0                                                     ' DD070401/ANSICHAT
  1292.       GOTO 33155
  1293. '
  1294. '
  1295. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1296. '
  1297. '
  1298. * REPLACING old line(s) by new
  1299. * ------[ first line different ]------
  1300. 33970 IF ZFunctionKey < 22 AND ZFunctionKey > 15 THEN _           'DGS-L25MOD
  1301.          MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 : _ 'DGS-L25
  1302.          CALL Line25                                              'DGS-L25
  1303.       END SUB                                                     'DGS-L25MOD
  1304. * REPLACING old line(s) by new
  1305. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  1306. ' $PAGE
  1307. '
  1308. '  NAME    -- PageUp
  1309. '
  1310. '  INPUTS  --     PARAMETER                    MEANING
  1311. '                 ZActiveUserName$       CURRENT USER NAME
  1312. '                 ZDnlds                 # OF FILES DOWNLOADED
  1313. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  1314. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  1315. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  1316. '                 ZPswdSave$             USERS PASSWORD
  1317. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  1318. '                 ZUplds                 # OF FILES UPLOADED
  1319. '                 ZUserSecSave           USERS SECURITY LEVEL
  1320. '
  1321. '  OUTPUTS -- ZMsgRec$
  1322. '
  1323.       SUB PageUp STATIC
  1324.       CALL LPrnt (" ",1)
  1325.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  1326.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  1327. * ------[ first line different ]------
  1328.       CALL LPrnt ("PASSWORD  : " + ZPswdSave$,1)
  1329.       CALL LPrnt ("BAUD RATE : "+  ZCBaud$ + " Bps",1)       'Pe 06/01/92
  1330.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  1331.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  1332.       CALL LPrnt ("LAST ON   : " + ZLastDateTimeOnSave$,1)
  1333.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  1334.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  1335.       IF ZEnforceRatios THEN _
  1336.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  1337.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  1338.       IF ZRestrictByDate THEN _
  1339.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  1340.       CALL LPrnt ("User's Profile",1)
  1341.       END SUB
  1342. * INSERTING new line(s)
  1343. 41005 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  1344. ' $PAGE
  1345. '
  1346. '  NAME    -- CheckTimeRemain
  1347. '
  1348. '  INPUTS  -- PARAMETER                 MEANING
  1349. '
  1350. '  OUTPUTS -- PARAMETER                 MEANING
  1351. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  1352. '             ZSecsUsedSession!     TIME USED IN SECONDS
  1353. '             ZSubParm              -1 IF No TIME LEFT
  1354. '
  1355.       SUB CheckTimeRemain (MinsRemaining) STATIC
  1356.       CALL TimeRemain (MinsRemaining)
  1357.       IF ZBypassTimeCheck THEN _
  1358.          EXIT SUB
  1359.      GOTO 41009
  1360. 41007 IF MinsRemaining < 1 AND ZBankTime < 1  THEN _
  1361.         ZSubParm = -1 : _
  1362.          Return 
  1363.        ZOutTxt$ = ZFG1$+" Your Time has Expired"+ZFG2$+" - "+ZFG3$+ _
  1364.                     " Access The Time Bank  ([Y],N) "
  1365.        ZTurboKey = -ZTurboKeyUser
  1366.        CALL TGet
  1367.        IF ZSubParm = -1 THEN _
  1368.         Return
  1369.          IF ZNO THEN _
  1370.           ZSubParm = -1 : _
  1371.          return
  1372.         CALL BankTime
  1373.        IF MinsRemaining <= 0 THEN _
  1374.       ZSubParm = -1 : _
  1375.       return
  1376. * DELETING old line(s)
  1377. 41008
  1378. * INSERTING new line(s)
  1379. 41009  IF MinsRemaining < 1 THEN _
  1380.           GOSUB 41007
  1381.        IF ZSubParm = -1 Then _
  1382.           EXIT SUB
  1383.         END SUB
  1384. * REPLACING old line(s) by new
  1385. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  1386. ' $PAGE
  1387. '
  1388. '  NAME    -- DispTimeRemain
  1389. '
  1390. '  INPUTS  --     PARAMETER                    MEANING
  1391. '              MinsRemaining
  1392. '
  1393. '  OUTPUTS --     PARAMETER                    MEANING
  1394. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  1395. '
  1396.       SUB DispTimeRemain (MinsRemaining) STATIC
  1397.       CALL TimeRemain (MinsRemaining)
  1398.       CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left")
  1399. * ------[ first line different ]------
  1400.       Call Line25            'Pe 05/30/91
  1401.       END SUB
  1402. * REPLACING old line(s) by new
  1403. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  1404. ' $PAGE
  1405. '
  1406. '  NAME    -- Carrier
  1407. '
  1408. '  INPUTS  --     PARAMETER                    MEANING
  1409. '              ZAutoLogoffReq                  -1 if in autologoff request
  1410. '
  1411. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  1412. '              ZSubParm = -1                   TERMINATE (No Carrier)
  1413. '
  1414. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  1415. '              NOT to continue are:  autologoff, out of time, or
  1416. '              carrier dropped.
  1417. '
  1418. * ------[ first line different ]------
  1419.       SUB Carrier STATIC                                             ' KG010902
  1420.       'IF ZAutoLogoffReq THEN _
  1421.       '   IF NOT ZSuspendAutologoff THEN _
  1422.       '      ZSubParm = -1 : _
  1423.       '      EXIT SUB
  1424.       CALL CheckCarrier
  1425.       END SUB
  1426. * REPLACING old line(s) by new
  1427. 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus")
  1428.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  1429. * ------[ first line different ]------
  1430.       ZSubParm = 1
  1431.       ZTurboKey = -ZTurboKeyUser
  1432.       CALL TGet
  1433.       IF ZSubParm = -1 THEN _
  1434.          EXIT SUB
  1435.       IF ZWasQ = 0 THEN _
  1436.          CALL QuickTPut1 ("Unchanged") : _
  1437.          EXIT SUB
  1438.       CALL AraAllCaps (ZUserIn$(),1)
  1439.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  1440.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  1441.          CALL QuickTPut1 ("Ascii unavailable.  Requires 8 bit") : _
  1442.          GOTO 43007
  1443.       IF ZWasGR = 0 THEN _
  1444.          GOTO 43006
  1445.       ZWasGR = ZWasGR - 1
  1446.       CALL SetGraphic (ZWasGR)
  1447.       END SUB
  1448. '
  1449. * REPLACING old line(s) by new
  1450. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  1451.       ZSubParm = 3
  1452.       CALL FileLock
  1453.       CALL OpenMsg
  1454.       FIELD 1, 128 AS ZMsgRec$
  1455.       GET 1,ZNodeRecIndex
  1456.       IF ZGlobalSysop THEN _
  1457.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  1458.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  1459.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  1460. * ------[ first line different ]------
  1461.       MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  1462.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  1463.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2)
  1464.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  1465.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  1466.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZOrigTimeLoggedOn$,2))) + _
  1467.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,4,2))) + _
  1468.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,7,2)))
  1469.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  1470.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  1471.       MID$(ZMsgRec$,75,1) = ZWasFT$
  1472.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  1473.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  1474.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  1475.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  1476.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  1477.       IF ZLocalUser THEN _
  1478.          ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _
  1479.       ELSE ZWasZ$ = " 0"
  1480.       MID$(ZMsgRec$,101,2) = ZWasZ$
  1481.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
  1482.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  1483.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  1484.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  1485.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  1486.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  1487.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  1488.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  1489.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  1490.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  1491. ' ***   Save additional parameters for door restoral
  1492.       CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1493.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  1494.       CALL PrintWorkA (ZWasNG$)
  1495.       CALL PrintWorkA (ZIndivValue$)
  1496.       CALL PrintWorkA (ZOrigDateTimeOn$)
  1497.       CALL PrintWorkA (ZOrigTimeLoggedOn$)
  1498.       CALL PrintWorkA (STR$(ZUserFileIndex))
  1499.       CALL PrintWorkA (ZUpldDir$)
  1500.       ZOutTxt$ = STR$(ZUpldDir$ = ZFMSDirectory$ OR ZLimitSearchToFMS)
  1501.       CALL PrintWorkA (ZOutTxt$)
  1502.       CALL PrintWorkA (ZCBaud$)
  1503.       CALL PrintWorkA (STR$(ZBankTime))        'lk 08/17/91 Save for Xpress
  1504.       CLOSE 2
  1505. * REPLACING old line(s) by new
  1506. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  1507. ' $PAGE
  1508. '
  1509. '  NAME    -- ReadProf
  1510. '
  1511. '  INPUTS  --     PARAMETER                    MEANING
  1512. '              ZNodeRecIndex               NODE RECORD TO USE
  1513. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  1514. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  1515. '
  1516. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  1517. '             UPON EXITING RBBS-PC TO A "DOOR"
  1518. '
  1519. '  PURPOSE -- Reset a user's options and communications parameters
  1520. '             that were saved in the node record when a user exited
  1521. '             to a "door" so that he is in the same status as when
  1522. '             he exited.
  1523. '
  1524.       SUB ReadProf STATIC
  1525.       FIELD 1, 128 AS ZMsgRec$
  1526.       GET 1,ZNodeRecIndex
  1527.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  1528.       MID$(ZMsgRec$,40,2) = "00"
  1529.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  1530. * ------[ first line different ]------
  1531.       ZBPS = VAL(MID$(ZMsgRec$,44,2))
  1532.       CALL CommInfo
  1533.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  1534.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  1535.       ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))
  1536.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  1537.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  1538.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  1539.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  1540.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  1541.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  1542.                         ":" + _
  1543.                         MinLoggedOn$ + _
  1544.                         ":" + _
  1545.                         SecLoggedOn$
  1546.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  1547.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  1548.       ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2))
  1549.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  1550.       CALL Trim (ZDooredTo$)
  1551.       IF ZExitToDoors AND ZDooredTo$ <> "" THEN _
  1552.          CALL OpenWork (2,ZDoorsDef$) : _
  1553.          IF ZErrCode = 0 THEN _
  1554.             CALL ReadParms (ZOutTxt$(),8,1) : _
  1555.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  1556.                CALL ReadParms (ZOutTxt$(),8,1) : _
  1557.             WEND : _
  1558.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  1559.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y")
  1560.       ZErrCode = 0
  1561.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  1562.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  1563.       CALL Remove (ZCurPUI$," ")
  1564.       IF ZCurPUI$ <> "" THEN _
  1565.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  1566.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  1567.       ZCustomPUI = (ZCurPUI$ <> "")
  1568.       ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$)
  1569.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  1570.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  1571.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  1572.       CALL Trim (ZHomeConf$)
  1573.       IF ZHomeConf$ = "MAIN" THEN _
  1574.          ZHomeConf$ = ""
  1575.       IF ZRequiredRings > 0 AND _
  1576.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  1577.          COLOR 7,0,0 _
  1578.       ELSE COLOR ZFG,ZBG,ZBorder
  1579.       IF ZLocalUserMode THEN _
  1580.          GOTO 44003
  1581.       CALL SetBaud
  1582. * REPLACING old line(s) by new
  1583. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _
  1584.                         VAL(MinLoggedOn$) * 60! + _
  1585.                         VAL(SecLoggedOn$)
  1586.       HourLoggedOn$ = ""
  1587.       MinLoggedOn$ = ""
  1588.       SecLoggedOn$ = ""
  1589.       IF ZMinsPerSession < 1 THEN _
  1590.          ZMinsPerSession = 3
  1591.       IF NOT ZEightBit THEN _
  1592.          OUT ZLineCntlReg,&H1A
  1593.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  1594.          ZFirstName$ = ZSysopPswd1$ : _
  1595. * ------[ first line different ]------
  1596.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  1597.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  1598.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  1599.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  1600.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  1601.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  1602.       ZWasZ$ = ZFirstName$
  1603.       CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1604.       CALL ReadDir (2,1)
  1605.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  1606.       CALL ReadDir (2,1)
  1607.       ZWasNG$ = ZOutTxt$
  1608.       CALL ReadDir (2,1)
  1609.       ZIndivValue$ = ZOutTxt$
  1610.       CALL ReadDir (2,1)
  1611.       ZOrigDateTimeOn$ = ZOutTxt$
  1612.       CALL ReadDir (2,1)
  1613.       ZOrigTimeLoggedOn$ = ZOutTxt$
  1614.       CALL ReadDir (2,1)
  1615.       ZUserFileIndex = VAL(ZOutTxt$)
  1616.       CALL ReadDir (2,1)
  1617.       ZUpldDoor$ = ZOutTxt$
  1618.       CALL ReadDir (2,1)
  1619.       ZFMSDoor = VAL(ZOutTxt$)
  1620.       CALL ReadDir (2,1)
  1621.       ZCBaud$ = ZOutTxt$
  1622.       CALL ReadDir (2,1)                  'lk 08/17/91 added for Silver Xpress
  1623.       ZTempBankTime = VAL (ZOutTxt$)      'lk 08/17/91 for Xpress
  1624.       CLOSE 2
  1625.       CALL DoorReturn
  1626.       END SUB
  1627. * REPLACING old line(s) by new
  1628. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  1629. ' $PAGE
  1630. '
  1631. '  NAME    -- CommInfo
  1632. '
  1633. '  INPUTS  --     PARAMETER                    MEANING
  1634. '                 ZBPS                BAUD RATE INDICATOR
  1635. '                 ZEightBit           INDICATE FOR N/8/1
  1636. '
  1637. '  OUTPUTS -- ZBaudParity$
  1638. '
  1639. '  PURPOSE -- Create a string that shows a users baud rate and parity
  1640. '
  1641.       SUB CommInfo STATIC
  1642. '
  1643. '
  1644. ' *  DETERMINE BAUD AND PARITY
  1645. '
  1646. '
  1647.   IF ZReliableMode THEN _
  1648.      ReliableMode$ = "-R," _
  1649.   ELSE ReliableMode$ = ","
  1650.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  1651. * ------[ first line different ]------
  1652.                  " BAUD" + _                             'Pe 07/18/91
  1653.                  ReliableMode$ + _
  1654.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  1655.   ZBaudTest! = VAL(ZBaudParity$)
  1656.   END SUB
  1657. * REPLACING old line(s) by new
  1658. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  1659. ' $PAGE
  1660. '
  1661. '  NAME    -- DispCall
  1662. '
  1663. '  INPUTS  --     PARAMETER           MEANING
  1664. '
  1665. '  OUTPUTS --  (NONE)
  1666. '
  1667. '  PURPOSE -- Displays callers file to sysops and callers
  1668. '
  1669.       SUB DispCall STATIC
  1670.       IF ZCallersFilePrefix$ = "" THEN _
  1671.          EXIT SUB
  1672.       PrevCal$ = ZCallersFile$
  1673.       OrigCal$ = ZCallersFile$
  1674. * ------[ first line different ]------
  1675.       IF (ZUserSecLevel < ZSysopSecLevel) THEN _
  1676.          GOTO 57004
  1677.       CALL LinesInFile (ZCallersLst$,NumItems)
  1678.       IF NumItems < 1 THEN _
  1679.          GOTO 57004
  1680.       IF ZAnsIndex < ZLastIndex THEN _
  1681.          GOTO 57003
  1682. * REPLACING old line(s) by new
  1683. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  1684.       GET 4,CallersFileIndexTemp!
  1685.       WasZ = INSTR(ZCallersRecord$,"{")
  1686.       IF WasZ < 1 OR WasZ > 15 THEN _
  1687.          WasZ = 15
  1688. * ------[ first line different ]------
  1689.       IF ZSysop OR _
  1690.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  1691.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  1692.       GOSUB 57100
  1693.       IF ZSysop THEN _
  1694.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  1695.          GOSUB 57100
  1696.       GOTO 57045
  1697. * REPLACING old line(s) by new
  1698. * ------[ first line different ]------
  1699. 57030 IF ZSysop THEN _
  1700.          GOSUB 57100
  1701. * REPLACING old line(s) by new
  1702. * ------[ first line different ]------
  1703. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  1704.          IF NOT ZSysop THEN _
  1705.             RETURN
  1706.       IF ZJumpSearching THEN _
  1707.          ZWasDF$ = ZOutTxt$ : _
  1708.          CALL AllCaps (ZWasDF$) : _
  1709.          IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  1710.             RETURN _
  1711.          ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  1712.               ZJumpSearching = ZFalse
  1713.       ZSubParm = 5
  1714.       CALL TPut
  1715.       WasX = 1
  1716.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  1717.       IF ZNo OR ZSubParm = -1 THEN _
  1718.          GOTO 57101
  1719.       RETURN
  1720. * REPLACING old line(s) by new
  1721. * ------[ first line different ]------
  1722. 57101 IF WasX < 999 AND ZSysOp AND NumItems > 1 THEN _
  1723.          PrevCal$ = ZCallersFile$ : _
  1724.          GOTO 57003
  1725. * REPLACING old line(s) by new
  1726. 58141 PrevLoadNew$ = ZFMSDirectory$
  1727.       CALL OpenFMS (LastRec,WasL)
  1728.       FIELD 2, 23 AS PreDate$, _
  1729.                 2 AS WasMM$, _
  1730.                 1 AS Fill1$, _
  1731.                 2 AS WasDD$, _
  1732.                 1 AS Fill2$, _
  1733.                 2 AS Year$, _
  1734. * ------[ first line different ]------
  1735.                 (2 + ZMaxDescLen) AS ZDesc$, _
  1736.                 3 AS Category$, _
  1737.                 2 AS Fill4$
  1738.       MaxRecs = UBOUND(Ara,1)
  1739.       IF MaxRecs < 1 THEN _
  1740.          MaxRecs = 1 _
  1741.       ELSE IF MaxRecs > 23 THEN _
  1742.               MaxRecs = 23
  1743.       WasL = 0
  1744.       WasK = LastRec
  1745.       WHILE WasK > 0 AND WasL < MaxRecs
  1746.          GET #2,WasK
  1747.          IF INSTR("*\ ",LEFT$(PreDate$,1)) > 0 THEN _
  1748.             GOTO 58142
  1749.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  1750.             IF VAL(Year$) > 79 THEN _
  1751.                WasL = WasL + 1 : _
  1752.                Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _
  1753.             ELSE IF FirstWarning THEN _
  1754.                     FirstWarning = ZFalse : _
  1755.                     ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _
  1756.                     ZSnoop = ZTrue : _
  1757.                     CALL LPrnt (ZWasZ$,1) : _
  1758.                     CALL UpdtCalr (ZWasZ$,2)
  1759.          IF NOT ZCanDnldFromUp THEN _
  1760.             WasX = ZMinSecToView _
  1761.          ELSE IF Category$ = "***" THEN _
  1762.                  WasX = ZSysopSecLevel _
  1763.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  1764.                       WasX = ZMinSecToView _
  1765.               ELSE IF LEFT$(PreDate$,1) = "=" THEN _
  1766.                       CALL CheckInt (ZDesc$) : _
  1767.                       WasX = ZTestedIntValue _
  1768.               ELSE WasX = ZOptSec(19)
  1769.          Ara(WasL,2) = WasX
  1770. * REPLACING old line(s) by new
  1771. 58165 ' $SUBTITLE: 'DispUpDir - sub to display FMS directory'
  1772. ' $PAGE
  1773. '
  1774. '  NAME    -- DispUpDir
  1775. '
  1776. '  INPUTS  -- PARAMETER             MEANING
  1777. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  1778. '                                 THE SEARCH.
  1779. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  1780. '                                 FILE "CATEGORIES" SELECTED
  1781. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  1782. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  1783. '                                 AND THE STRING TO SEARCH.
  1784. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  1785. '                                 VIEWING - 0 IF AT END
  1786. '
  1787. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  1788. '                                 TO 1.  OTHERWISE LEAVES AT ZERO
  1789. '  PURPOSE -- Display the files that meet the criteria selected in
  1790. '             RBBS-PC upload management system on the users screen.
  1791. '
  1792.       SUB DispUpDir (PassedCats$,SearchString$, _
  1793.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  1794.       IF AtEndList THEN _
  1795.          AtEndList = ZFalse : _
  1796.          IF DnldFlag > 0 THEN _
  1797.             GOSUB 58185 : _
  1798.             GOTO 58184
  1799.       CALL AllCaps (SearchString$)
  1800.       Blank$ = " "
  1801.       ZStopInterrupts = ZFalse
  1802.       Categories$ = "," + _
  1803.                     PassedCats$ + _
  1804.                     ","
  1805.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  1806.       CanView = (ZUserSecLevel => ZOptSec(26))
  1807.       ZJumpSupported = ZTrue
  1808.       ZJumpSearching = ZFalse
  1809.       GOSUB 58185
  1810.       OrigDir$ = ZActiveFMSDir$
  1811.       InList = (RelistAt > 0 AND ReListAt <= LastRec)
  1812.       IF InList AND DnldFlag > 0 THEN _
  1813.          UpldIndex = RelistAt : _
  1814.          DnldFlag = 0 : _
  1815.          GOTO 58179
  1816.       ZJumpLast$ = ""
  1817.       SearchFor$ = SearchString$
  1818. * ------[ first line different ]------
  1819.       ExtraPrompt$ = LEFT$(",T)ype",6+4*ZExpertUser)                 'Pe 10/21/89
  1820.       ExtraPrompt$ = ExtraPrompt$ + LEFT$(",V)iew",6+4*ZExpertUser)  'Pe 10/21/89
  1821.       IF ZPersonalDnld THEN _
  1822.          ExtraPrompt$ = ExtraPrompt$ + ",*)new"
  1823.       IF CanDnld THEN _
  1824.          ExtraPrompt$ = ExtraPrompt$ + ",E)xtra,M)ark,D)nld"    'Pe 11/07/91
  1825.       MaxPrint = ZPageLength - 1
  1826.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  1827.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  1828.       FMSCheckPoint = 0
  1829.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  1830.                      OR (INSTR(SearchString$,"*") > 0)
  1831.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  1832.       IF ZAnsIndex > 0 THEN _
  1833.         IF ZLastCommand$ = "FP" AND INSTR("Ll",ZUserIn$(ZLastIndex)) = 0 THEN _
  1834.             ZUserIn$(ZAnsIndex) = "D" : _
  1835.             IF (UpldIndex > 0 AND UpldIndex <= LastRec) THEN _
  1836.                GOTO 58180 _
  1837.             ELSE Temp$ = "" : _
  1838.                  GOTO 58196
  1839. * REPLACING old line(s) by new
  1840. 58174 IF SearchDate$ <> "" THEN _
  1841.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  1842.                 MID$(PartToPrint$,24,2) + _
  1843.                 MID$(PartToPrint$,27,2) : _
  1844.          IF HoldCat$ < SearchDate$ THEN _
  1845.             IF ZDateOrderedFMS THEN _
  1846. * ------[ first line different ]------
  1847.                GOTO 58184 _
  1848.             ELSE GOTO 58168
  1849. '
  1850. '
  1851. ' * Allow the FMS to be both fast and interruptable if a local
  1852. ' * user or there is nothing in the input buffer by using QuickTPut.
  1853. '
  1854. '
  1855. * REPLACING old line(s) by new
  1856. 58180 WasX$ = ZUserIn$(ZAnsIndex)
  1857.       CALL AllCaps (WasX$)
  1858.       IF InList AND (ZAnsIndex >= ZLastIndex OR WasX$ <> "D") THEN _
  1859.          ZTurboKey = -ZTurboKeyUser : _
  1860.          ZStackC = ZTrue : _
  1861.          CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) : _
  1862.          IF ZSubParm = -1 THEN _
  1863.             EXIT SUB _
  1864.          ELSE ZLastIndex = ZWasQ :_
  1865. * ------[ first line different ]------
  1866.          IF NOT ZNo THEN _
  1867.             ZAnsIndex = 1
  1868.       IF ZSubParm = -1 THEN _
  1869.          GOTO 58198
  1870.       IF ZNo THEN _
  1871.          ZLastIndex = 0 : _
  1872.          GOTO 58198
  1873.       WasX$ = ZUserIn$(ZAnsIndex)
  1874.       CALL AllCaps (WasX$)
  1875. '
  1876. 'Type TXT file mod  Pe 10/21/89
  1877. '
  1878.       IF WasX$ = "T" THEN _
  1879.          CALL TypeFile : _
  1880.          ZwasA = UpldIndex : _
  1881.          GOSUB 58185 : _
  1882.          UpldIndex = ZwasA : _
  1883.          GOTO 58180
  1884. '
  1885. '
  1886.       IF WasX$ = "V" THEN IF CanView THEN _
  1887.          CALL GetArc : _
  1888.          ZJumpSupported = ZTrue : _
  1889.          ZWasA = UpldIndex : _
  1890.          GOSUB 58185 : _
  1891.          UpldIndex = ZWasA : _
  1892.          GOTO 58180
  1893. '
  1894. '   
  1895.      IF WasX$ = "E" THEN _                  'Pe 11/07/91
  1896.       ZExtendedOff=NOT ZExtendedOff: _       'Pe 11/07/91
  1897.       CALL QuickTPut1 ("Extended directory display "+FNOffOn$(NOT ZExtendedOff)) : _
  1898.       GOTO 58168
  1899. '
  1900. '
  1901. * REPLACING old line(s) by new
  1902. 58181 MarkingFiles = ZFalse
  1903.       IF (WasX$ = "D" OR WasX$ = "M") THEN IF CanDnld THEN _
  1904. * ------[ first line different ]------
  1905.  MarkingFiles = (WasX$ = "M") : _
  1906.          AtEndList = ZFalse : _                                  'PE 08/04/91
  1907.          CALL AskItems ("DM",WasX$,ZTrue,"file",ZMarkedFiles$)
  1908.          IF ZWasQ = 0 THEN _
  1909.             GOTO 58183
  1910.       IF WasX$ = "*" THEN IF ZPersonalDnld THEN _
  1911.          GOTO 58193
  1912. * REPLACING old line(s) by new
  1913. 58183 IF ZJumpSearching THEN _
  1914.          PrevSearch$ = SearchFor$ : _
  1915.          SearchFor$ = ZJumpTo$ _
  1916.       ELSE SearchFor$ = SearchString$ : _
  1917.            IF NOT ZYes AND CanDnld THEN _
  1918.               GOSUB 58188 : _
  1919. * ------[ first line different ]------
  1920. IF WasX$ <> "L" AND ZLastIndex >= ZAnsIndex AND NOT MarkingFiles AND NOT AtEndList THEN _ ' Pe 080391
  1921.                  CALL SkipLine (1) : _
  1922.                  DnldFlag = 1 : _
  1923.                  ReListAt = UpldIndex : _
  1924.                  EXIT SUB _
  1925.               ELSE IF UpldIndex = CutoffRec THEN _
  1926.                       GOTO 58184
  1927.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  1928.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  1929.             ZOutTxt$ = STR$(UpldIndex) + _
  1930.                " lines left to search.  Really go non-stop? (Y,[N])" : _
  1931.             ZNoAdvance = ZTrue : _
  1932.             ZTurboKey = -ZTurboKeyUser : _
  1933.             ZSubParm = 1 : _
  1934.             CALL TGet : _
  1935.             CALL WipeLine (79) : _
  1936.             ZNonStop = ZYes
  1937.       GOTO 58168
  1938. * REPLACING old line(s) by new
  1939. 58184 IF ZChainedDir$ <> "" THEN _
  1940.          ZActiveFMSDir$ = ZChainedDir$ : _
  1941.          GOSUB 58185 : _
  1942.          LastFName = 0 : _
  1943.          GOTO 58168
  1944. * ------[ first line different ]------
  1945.       IF ZNo THEN _
  1946.          GOTO 58198
  1947.       Temp$ = "End list. "
  1948.       AtEndList = ZTrue
  1949.       UpldIndex = CutOffRec - ZUpInc
  1950.       ZLastIndex = 0
  1951.       GOTO 58196
  1952. * REPLACING old line(s) by new
  1953. 58185 IF PassedCats$ = "P" THEN _
  1954.          ZActiveFMSDir$ = ZPersonalDir$
  1955.       CALL OpenFMS (UpldIndex,CatLen)
  1956.       LastRec = UpldIndex
  1957.       EndDesc = 33 + ZMaxDescLen
  1958.       IF CatLen > 3 THEN _
  1959.          Categories$ = ZActiveUserName$ : _
  1960.          CALL Trim (Categories$) : _
  1961.          Categories$ = "," + Categories$ + "," + LEFT$(",SYSOP,",-7*ZSysOp) : _
  1962.          CanDnld = ZTrue : _
  1963.          StatLen = 1 _
  1964.       ELSE StatLen = 0
  1965. * ------[ first line different ]------
  1966.       FIELD 2, EndDesc AS PartToPrint$, _
  1967.                CatLen AS Category$, _
  1968.                StatLen AS PersonalStatus$, _
  1969.                2 AS Filler$
  1970.       PrevFMS$ = ZActiveFMSDir$
  1971. * REPLACING old line(s) by new
  1972. 58188 IF ProcessedNew OR MarkingFiles OR NOT ZListOnly THEN _
  1973.          ProcessedNew = ZFalse : _
  1974.          RETURN
  1975.       ZUserIn$(0) = ""
  1976.       WasI = ZAnsIndex              ' check whether in dir
  1977.       WHILE WasI <= ZLastIndex
  1978.          CALL AraAllCaps (ZUserIn$(),WasI)
  1979.          ZWasZ$ = ZUserIn$(WasI)
  1980.          CALL UnMarkItems (ZMarkedFiles$,WasI,ZLastIndex,WasX,ZTrue)
  1981.          Temp$ = ZUserIn$(WasI)
  1982. * ------[ first line different ]------
  1983.          IsProto = (LEN(Temp$) = 1 AND _
  1984.                     INSTR(ZDefaultXfer$,Temp$) > 0)
  1985.          ZOK = IsProto
  1986.          WasJ = LastRec + 1
  1987.          WasX = INSTR(Temp$,".")
  1988.          AltTemp$ = ""
  1989.          IF NOT IsProto THEN _
  1990.             IF WasX = 0 THEN _
  1991.                AltTemp$ = Temp$ + "." + ZDefaultExtension$ _
  1992.             ELSE IF WasX = LEN(Temp$) THEN _
  1993.                     AltTemp$ = LEFT$(Temp$,WasX-1)
  1994.          WHILE WasJ > 1 AND NOT ZOK
  1995.             WasJ = WasJ - 1
  1996.             GET #2,WasJ
  1997.             GOSUB 58191
  1998.             IF CanGet THEN _
  1999.                MID$(PartToPrint$,13,1) = " " : _
  2000.                WasX$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) : _
  2001.                ZOK = (Temp$ = WasX$) : _
  2002.                IF NOT ZOK THEN _
  2003.                   IF AltTemp$ <> "" THEN _
  2004.                   ZOK = (AltTemp$ = WasX$)
  2005.          WEND
  2006.          IF ZOK THEN _
  2007.             GOSUB 58189 : _
  2008.             IF ZOK OR IsProto THEN _
  2009.                WasX$ = MID$(STR$(WasJ),2) : _
  2010.                ZUserIn$(0) = ZUserIn$(0) + _
  2011.                        WasX$ + _
  2012.                        SPACE$(5 - LEN(WasX$))
  2013.          IF NOT ZOK AND NOT IsProto THEN _
  2014.             CALL QuickTPut1 (ZWasZ$ + " not found - omitted") : _
  2015.             FOR WasK = WasI + 1 TO ZLastIndex : _
  2016.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  2017.             NEXT : _
  2018.             ZLastIndex = ZLastIndex - 1 : _
  2019.             WasI = WasI - 1
  2020.          WasI = WasI + 1
  2021.       WEND
  2022.       ZWasQ = ZLastIndex
  2023.       RETURN
  2024. * REPLACING old line(s) by new
  2025. 58189 IF IsProto THEN _
  2026.          RETURN
  2027.       ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  2028.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  2029.       IF ZOK THEN _
  2030.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  2031. * ------[ first line different ]------
  2032.      ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  2033.                       ((ZUserSecLevel < ZMinSecToView) OR _
  2034.                        NOT ZCanDnldFromUp),ZTrue,"D") : _
  2035.            GOSUB 58185
  2036.       RETURN
  2037. * REPLACING old line(s) by new
  2038. 58196 CALL QuickTPut (ZEmphasizeOff$,0)
  2039. * ------[ first line different ]------
  2040.       ZOutTxt$ = Temp$ + "L)ist,A)bort,T)ype,V)iew," + _             ' Pe 03/30/92
  2041.                  LEFT$("*)dnld new,",-11*ZPersonalDnld) + _
  2042.                  "M)ark" + LEFT$(",D)ownload",-10*CanDnld) + ZPressEnterExpert$
  2043.       ZTurboKey = -ZTurboKeyUser
  2044. If ZDnldCompleted and ZAutoEnd = 1 THEN _   'Pe 10/22/91
  2045.       Goto 58198
  2046.       CALL PopCmdStack
  2047.       WasX$ = ZUserIn$(ZAnsIndex)
  2048.       CALL AllCaps (WasX$)
  2049.       IF WasX$ = "A" THEN ZRet = ZTrue
  2050.       IF ZWasQ = 0 OR ZRet OR ZSubParm < 0 THEN _
  2051.          GOTO 58198
  2052. '
  2053.       IF WasX$ = "L" THEN _
  2054.          ZActiveFMSDir$ = OrigDir$ : _
  2055.          GOSUB 58185 : _
  2056.          AtEndList = ZFalse : _
  2057.          GOTO 58168   
  2058. '
  2059. 'Type TXT file mod  Pe 10/21/89
  2060. '
  2061.       IF WasX$ = "T" THEN _
  2062.          CALL TypeFile : _
  2063.          ZwasA = UpldIndex : _
  2064.          GOSUB 58185 : _
  2065.          UpldIndex = ZwasA : _
  2066.          GOTO 58180
  2067. '
  2068. '
  2069.       IF WasX$ = "V" THEN IF CanView THEN _
  2070.          CALL GetArc : _
  2071.          ZJumpSupported = ZTrue : _
  2072.          ZWasA = UpldIndex : _
  2073.          GOSUB 58185 : _
  2074.          UpldIndex = ZWasA : _
  2075.          GOTO 58180
  2076.          ZYes = ZFalse 
  2077.          Goto 58181
  2078. * REPLACING old line(s) by new
  2079. 58198 CLOSE 2
  2080.       ZNonStop = (ZPageLength < 1)
  2081.       ZStopInterrupts = ZFalse
  2082.       ZOutTxt$ = ""
  2083.       ZActiveFMSDir$ = ""
  2084.       ZJumpSupported = ZFalse
  2085.       DnldFlag = 0
  2086.       EXIT SUB
  2087.       END SUB
  2088. * ------[ first line different ]------
  2089. '
  2090. ' $SUBTITLE: 'TypeFile - subroutine to TYPE an ASCII FILE'
  2091. ' $PAGE
  2092. '
  2093. '  NAME    -- TYPEAFILE
  2094. '
  2095. '  PARAMETERs          
  2096. '                      
  2097. '                      
  2098. '                      
  2099. '
  2100. '  PURPOSE -- Type a ASCII file to screen
  2101. '
  2102.       SUB TypeFile STATIC
  2103. * INSERTING new line(s)
  2104. 59141 CALL SkipLine (1)
  2105.        ZOutTxt$ = "What ASCII file(s) to Type"+ZPressEnterExpert$
  2106.         CALL PopCmdStack
  2107.        IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2108.       EXIT SUB
  2109. 59142 ZViolation$ = "TYPE File"
  2110.       WasX = ZAnsIndex
  2111.      FOR ZAnsIndex = WasX TO ZLastIndex
  2112.       GOSUB 59143
  2113.         IF ZSubParm < 0 THEN _
  2114.        ZAnsIndex = ZLastIndex + 1
  2115.       NEXT ZAnsIndex
  2116.       IF ZLastIndex > 1 THEN _
  2117.          EXIT SUB _
  2118.       ELSE GOTO 59141
  2119. 59143  WasZ$ = ZUserIn$(ZAnsIndex)
  2120.        CALL AllCaps (WasZ$)
  2121.     IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  2122.    CALL QuickTPut ("Sorry Widcars NOT allowed !",1) : _
  2123.     RETURN
  2124.        ZFileName$ = WasZ$
  2125.         ZFileNameHold$ = WasZ$
  2126.          CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  2127.         ON BadFileNameIndex GOTO 59145,59148,59150
  2128. 59145 CALL BadName (BadFileNameIndex,ZTrue)          'Pe 06/03/91
  2129.       ON BadFileNameIndex GOTO 59146,59150
  2130. 59146 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") 'Pe 02/25/90
  2131.        IF ZOK THEN _        ' Pe 02/06/90
  2132.         GOTO 59158
  2133. '
  2134. '**********************8 Pe 08/12/91 next 5 lines *********
  2135. If ZPersonalDnld Then _
  2136.   ZFileName$ = ZPersonalDrvPath$ + WasZ$ : _
  2137. CALL FindFile (ZFileName$,ZOK)
  2138.  IF ZOK THEN _
  2139.     GOTO 59158
  2140. '************************************************************
  2141. 59148 WasZ$ = ZUserIn$(ZAnsIndex) + _
  2142.            " not found!"
  2143.       CALL UpdtCalr (WasZ$,2)
  2144.       ZOutTxt$ = WasZ$ + _
  2145.            " Type correct filename" + ZPressEnterExpert$
  2146.       ZSubParm = 1
  2147.       CALL TGet
  2148.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2149.          RETURN
  2150.       ZUserIn$(ZAnsIndex) = ZUserIn$(1) 
  2151.       GOTO 59143
  2152. 59150 CALL SecViolation
  2153.       IF ZDenyAccess THEN _
  2154.          EXIT SUB
  2155.       GOTO 59148
  2156. 59158 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
  2157.       IF Ext$ = "" THEN _
  2158.         GOTO 59160
  2159.       IF INSTR("DWC,COM,EXE,GIF,PIC,DAT,BIN,ZIP,ARC,LZH,ZOO,PAK,ARJ,",Ext$+",") > 0 THEN _
  2160.  CALL QuickTPut ("Not an ASCII File, Cannot Type files with " +Ext$ + " Extensions",1) : _
  2161.          RETURN
  2162. 59160  CALL BufFile (ZFileName$,WasX) 
  2163.        RETURN
  2164.        END SUB
  2165. '************************ Pe 01/25/92  to end of file **************
  2166. '
  2167. ' $SUBTITLE: 'WhoDidIt - subroutine to Display Who Uploaded that file'
  2168. ' $PAGE
  2169. '
  2170. '  NAME    -- WhoDidIt
  2171. '
  2172. '  PARAMETERs None
  2173. '                      
  2174. '                      
  2175. '                      
  2176. '
  2177. 'PURPOSE - Maple Version of RBBS creates a file Called Uploadlg.def
  2178. '          this file keeps track of who Uploaded what file
  2179. '          File location is Drive/Path were *.DIR files are stored 'Pe 03/13/92
  2180. '          Allows reading UPLOADLG.DEF file in reverse order
  2181. '
  2182.       SUB WhoDidIt STATIC
  2183. 59500 CALL SkipLine (3)
  2184.  
  2185. ZOutTxt$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + ZCrLF$+_
  2186. " File Name    Uploader                          Date         Time"+ZCRLF$ + _
  2187.            "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" 
  2188. Call QuickTput1 (ZOutTxt$)
  2189.     Close 8
  2190.    IF ZShareIt THEN _
  2191.      OPEN ZDirPath$ +"UPLOADLG.DEF" FOR RANDOM SHARED AS #8 LEN=86 _  'Pe 03/13/92
  2192.         ELSE OPEN "R",8,ZDirPAth$ +"UPLOADLG.DEF",86                  'Pe 03/13/92
  2193.                    FIELD 8,84 AS ShowUp$, _
  2194.                    2 AS fill$
  2195.          RecordNum! = FIX(LOF(8) / 86)
  2196.         ZJumpSupported = ZTrue
  2197.        ZJumpSearching = ZFalse
  2198.       ZJumpLast$ = ""
  2199. 59502 If RecordNum! < 1 OR ZRet THEN  _
  2200.        GOTO 59560
  2201.         Get #8, RecordNum!
  2202.          ZOutTxt$ = ShowUp$
  2203.           RecordNum! = RecordNum! - 1
  2204.  
  2205. ' Do Not display Sysop only and Personall Uploads
  2206.  
  2207.  IF INSTR(ZOutTxt$,"*") > 0 and NOT ZSysop THEN _
  2208.           GOTO 59502
  2209.  
  2210.          GOSUB 59550
  2211.         GOTO 59502      
  2212.  
  2213. 59550   IF ZJumpSearching THEN _
  2214.           ZWasDF$ = ZOutTxt$ : _
  2215.            CALL AllCaps (ZWasDF$) : _
  2216.             IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  2217.                Return _
  2218.              ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  2219.               ZJumpSearching = ZFalse
  2220.              ZSubParm = 5
  2221.             CALL SmartText (ZOutTxt$,ZTrue,ZFalse)
  2222.            CALL Tput
  2223.           WasX=1
  2224.         CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2225.          IF ZNo OR ZSubParm = -1 THEN _
  2226.             ZJumpSupported = ZFalse : _
  2227.               ZJumpSearching = ZFalse : _
  2228.                ZJumpLast$ = "" : _
  2229.               Close 8 : _
  2230.            Exit Sub 
  2231.       Return
  2232. 59560 IF ZJumpSearching Then _
  2233.       Call QuickTput1 ("...Search string NOT found"+ZCrLf$)
  2234.       ZJumpSupported = ZFalse
  2235.       ZJumpSearching = ZFalse
  2236.       ZJumpLast$ = ""
  2237.       Close 8
  2238.      End Sub
  2239.